;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;quix.lisp
;;
;;  copyright © 1987-89 Apple Computer
;;
;;  This file demonstrates a simple stand-alone application
;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  we require traps and records at compile time, but not at load time.
;;  in this way, we can compile the file to a fasl file, quit Pearl,
;;  load the compiled file (at which point traps and records aren't loaded),
;;  and then do a save application.
;;  By doing this, our final application is smaller
;;

(eval-when (eval compile)
  (require 'traps)
  (require 'records))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; definitions for two Quickdraw functions which are slightly simpler
;; (and therefore faster) than the ones in Quickdraw.lisp
;;

(defobfun (frame-rect *window*) (left top right bottom)
  (with-port wptr
    (rlet ((r :rect :left left
                    :top top
                    :right right
                    :bottom bottom))
    (_FrameRect :ptr r))))

(defobfun (frame-oval *window*) (left top right bottom)
  (with-port wptr
    (rlet ((r :rect :left left
                    :top top
                    :right right
                    :bottom bottom))
    (_FrameOval :ptr r))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  some parameters used by quix
;;

(defvar *quix-shape* (ask *window*
                       #'frame-rect)
  "determines whether ovals or squares are drawn")

(defvar *quix-lines* t
  "determines whether lines are drawn")

(defvar *param-dialog* nil
  "will hold the dialog-box for choosing parameters")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  the quix window class
;;

(defobject *quix-window* *window*)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  exist adds a default window-title, and sets pen-mode to xor
;;

(defobfun (exist *quix-window*) (init-list)
  (usual-exist (init-list-default init-list
                                  :window-title "Quix"))
  (with-port wptr (_PenMode :word 10)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  window close throws to :abort to prevent further drawing in
;;  the (closed) window

(defobfun (window-close *quix-window*) ()
  (usual-window-close)
  (throw :abort :abort))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  this is the function that does most of the drawing
;;

(defun quix (x1 y1 x2 y2 dx1 dy1 dx2 dy2)
  (declare (type integer x1 y1 x2 y2 dx1 dy1 dx2 dy2))
  (declare (optimize (safety 0) (speed 3)))
  (unless (%set-toplevel) (throw :abort nil))
    (if (or (minusp x1) (> x1 (point-h (window-size))))
      (setq dx1 (- dx1) dy1 (min 5 (+ dy1 (- 1 (random 3))))))
    (if (or (minusp y1) (> y1 (point-v (window-size))))
      (setq dy1 (- dy1) dx1 (min 5 (+ dx1 (- 1 (random 3))))))
    (if (or (minusp x2) (> x2 (point-h (window-size))))
      (setq dx2 (- dx2) dy2 (min 5 (+ dy2 (- 1 (random 3))))))
    (if (or (minusp y2) (> y2 (point-v (window-size))))
      (setq dy2 (- dy2) dx2 (min 5 (+ dx2 (- 1 (random 3))))))
    (when *quix-lines*
      (with-port wptr
        (_MoveTo :word x1 :word y1)
        (_LineTo :word x2 :word y2)))
    (if (and (< x1 x2)(< y1 y2)) (funcall *quix-shape* x1 y1 x2 y2))
    (if (and (< x1 x2)(< y2 y1)) (funcall *quix-shape* x1 y2 x2 y1))
    (if (and (< x2 x1)(< y1 y2)) (funcall *quix-shape* x2 y1 x1 y2))
    (if (and (< x2 x1)(< y2 y1)) (funcall *quix-shape* x2 y2 x1 y1))
    (quix (+ x1 dx1) (+ y1 dy1) (+ x2 dx2) (+ y2 dy2) dx1 dy1 dx2 dy2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  this function creates a quix window and starts the process of drawing into
;;  it.  This is the main loop of the application
;;

(defun demo (&aux error-val)
  (catch :abort
    (catch :cancel
      (setq error-val
            (catch :error
              (let ((d2 (oneof *quix-window*
                               :window-size (make-point (- *screen-width* 4)
                                                        (- *screen-height* 105))
                               :window-position #@(2 101))))
                (ask d2 (quix (random (point-h (window-size)))
                              (random (point-v (window-size)))
                              (random (point-h (window-size)))
                              (random (point-v (window-size)))
                              (- 5 (random 9))
                              (- 5 (random 9))
                              (- 5 (random 9))
                              (- 5 (random 9)))))))
      ;if there is a throw to error, the following code will be executed.
      (message-dialog (format nil "An error has occurred ~s" error-val)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  this function initializes the application by setting *inihibit-error* to t
;;  (so we don't get a listener popping up), and creating a parameter dialog.

(defun init-quix ()
  (catch :error
    (catch :cancel
      (catch :abort
        (setq *inhibit-error* t)
        (init-p-dialog)
        (%set-toplevel #'demo)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  this function is called by one of the items on the Quix menu
;;

(defun param-dialog ()
  (modal-dialog *param-dialog* nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  this function initializes the parameter dialog
;;  it is called only once, at startup time
;;

(defun init-p-dialog (&aux rect-function oval-function)
  (ask *window*
    (setq rect-function #'frame-rect
          oval-function #'frame-oval))
  (setq *param-dialog*
        (oneof *dialog*
               :window-type :double-edge-box
               :window-position #@(40 36)
               :window-size #@(190 36)
               :default-button nil
               :window-show nil
               :dialog-items
               (list
                (oneof *radio-button-dialog-item*
                       :dialog-item-text "Ovals"
                       :dialog-item-position #@(4 4)
                       :dialog-item-action
                       #'(lambda ()
                           (setq *quix-shape* oval-function)
                           (radio-button-push)))
                (oneof *radio-button-dialog-item*
                       :dialog-item-text "Squares"
                       :dialog-item-position #@(4 20)
                       :radio-button-pushed-p t
                       :dialog-item-action
                       #'(lambda ()
                           (setq *quix-shape* rect-function)
                           (radio-button-push)))
                (oneof *check-box-dialog-item*
                       :dialog-item-text "Draw Lines"
                       :dialog-item-position #@(80 4)
                       :check-box-checked-p t
                       :dialog-item-action
                       ;we need to use nfunction so we can call usual
                       (nfunction dialog-item-action
                                  (lambda ()
                                    (usual-dialog-item-action)
                                    (setq *quix-lines*
                                          (check-box-checked-p)))))
                (oneof *button-dialog-item*
                       :dialog-item-text "   OK   "
                       :dialog-item-position #@(80 20)
                       :dialog-item-size #@(99 16)
                       :dialog-item-action #'(lambda ()
                                               (return-from-modal-dialog nil)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  create a set of menus for working with Quix
;;
;;  the Quit menu simply sets toplevel to nil
;;  the main function in the program checks the value of toplevel, and returns
;;  when it is nil.
;;

(defvar *quix-menu* (oneof *menu*
                         :menu-title "Quix"
                         :menu-items
                         (list
                          (oneof *menu-item*
                                 :menu-item-title "Set Parameters"
                                 :menu-item-action #'param-dialog)
                          (oneof *menu-item*
                                 :menu-item-title "Quit"
                                 :menu-item-action #'(lambda ()
                                                       (%set-toplevel nil))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  add a standard edit menu

(defvar *standard-edit-menu* (oneof *menu* :menu-title "Edit"))

(ask *standard-edit-menu*
  (add-menu-items
   ;undo should be fancier, to support window-can-undo-p
   (oneof *window-menu-item*
          :menu-item-title "Undo"
          :menu-item-action 'undo
          :command-key #\z)
   (oneof *window-menu-item*
          :menu-item-title "-")
   (oneof *window-menu-item*
          :menu-item-title "Cut"
          :menu-item-action 'cut
          :command-key #\x)
   (oneof *window-menu-item*
          :menu-item-title "Copy"
          :menu-item-action 'copy
          :command-key #\c)
   (oneof *window-menu-item*
          :menu-item-title "Paste"
          :menu-item-action 'paste
          :command-key #\v)
   (oneof *window-menu-item*
          :menu-item-title "Clear"
          :menu-item-action 'clear)
   (oneof *window-menu-item*
          :menu-item-title "Select All"
          :menu-item-action 'select-all
          :command-key #\a)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;the about-quix menu item is installed in the apple menu

(defvar *about-quix-menu-item*
  (oneof *menu-item*
         :menu-item-title "About QuixÉ"
         :menu-item-action
         #'(lambda ()
             (modal-dialog
              (oneof *dialog*
                     :window-size #@(290 30)
                     :window-position #@(40 36)
                     :window-type :double-edge-box
                     :window-show nil
                     :dialog-items
                     (list (oneof *static-text-dialog-item*
                                  :dialog-item-text
                                  "Quix Demo.  Written in Pearl Lisp."
                                  :dialog-item-size #@(220 17)
                                  :dialog-item-font '("Geneva" 12))
                           (oneof *button-dialog-item*
                                  :dialog-item-text "   OK   "
                                  :dialog-item-action
                                  #'(lambda ()
                                      (return-from-modal-dialog nil)))))))))



#|
;;the compiled version of this file will contain all the expressions
;;above.  Once we compile the file, we quit pearl, re-boot Pearl, load the
;;fasl file, and evaluate the following expressions to get our application


;;dispose of all the standard menus
(dolist (m *default-menubar*)
  (ask m (menu-dispose)))

;;this changes the apple-menu to have our about box
(ask *apple-menu*
  (apply #'remove-menu-items (menu-items))
  (add-menu-items
    *about-quix-menu-item*
    (oneof *menu-item*
           :menu-item-title "-")))

;we install our menus
(ask *quix-menu* (menu-install))
(ask *standard-edit-menu* (menu-install))

(save-application (choose-new-file-dialog :pathname "quix")
                  :toplevel-function #'init-quix)

|#